home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Dynamic Bu22180742001.psc / Modules / modNoFocusRect.bas < prev   
Encoding:
BASIC Source File  |  2001-07-04  |  1.8 KB  |  40 lines
  1. Attribute VB_Name = "modNoFocusRect"
  2. 'API Declarations
  3. Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  4. Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  5. Private Declare Function CallWindowProc Lib "User32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  6.  
  7. 'Consts
  8. Private Const GWL_WNDPROC = (-4)
  9. Private Const WM_ACTIVATE = &H6
  10. Private Const WM_SETFOCUS = &H7
  11.  
  12. 'Vars
  13. Public StandardButtonProc As Long
  14.  
  15. Public Sub NoFocusRect(Button As Object, vValue As Boolean)
  16.     If vValue = True Then 'Focus rect on
  17.         'Save the adress of the standard button procedure
  18.         StandardButtonProc = GetWindowLong(Button.hWnd, GWL_WNDPROC)
  19.         'Subclass the button to control its Windows Messages
  20.         SetWindowLong Button.hWnd, GWL_WNDPROC, AddressOf ButtonProc
  21.     Else 'Focus rect off
  22.         'Remove the subclassing from the button
  23.         SetWindowLong Button.hWnd, GWL_WNDPROC, StandardButtonProc
  24.     End If
  25. End Sub
  26.  
  27. Public Function ButtonProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  28.     'The procedure that gets all windows messages for the subclassed
  29.     'button
  30.     On Error Resume Next
  31.     Select Case uMsg&
  32.         'The button is going to get the focus
  33.         Case WM_SETFOCUS
  34.         'Exit the procedure -> The message doesn┤t reach the button
  35.         Exit Function
  36.     End Select
  37.     'Call the standard Button Procedure
  38.     ButtonProc = CallWindowProc(StandardButtonProc, hWnd&, uMsg&, wParam&, lParam&)
  39. End Function
  40.